home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / htmlCustom.tcl < prev    next >
Text File  |  1997-03-04  |  39KB  |  1,088 lines
  1. #=============================================================================
  2. #
  3. #    htmlCustom.tcl
  4. #
  5. #    Part of HTML mode 1.4.1
  6. #
  7. #    HTML custom elements.
  8. #
  9. #    Copyright 1996, 1997 by Johan Linde <jl@theophys.kth.se>.
  10. #    This software may be used freely, and distributed freely, as long as 
  11. #    the receiver is not obligated in any way by receiving it.
  12. #
  13. #    If you make improvements to this file, please share them!
  14. #
  15. #=============================================================================
  16.  
  17. #
  18. # Defining new HTML elements.
  19. #
  20. proc htmlCustomNewElem {} {
  21.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemAttrUsed
  22.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  23.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins htmlElemAttrMore
  24.     global HTMLmodeVars specURL specColor specWindow htmlSpecURL htmlSpecColor htmlSpecWindow
  25.     global htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  26.     
  27.     if {$htmlPackageToUse != 1} {return}
  28.     if {[info exists htmlShownWarning]} {htmlDisabled}
  29.     set invalidInput 1
  30.     set values {"" 1 1 0 0 "" 0 0 0 0}
  31.     while {$invalidInput} {
  32.         set box "-t {New element} 10 10 100 25 -e [list [lindex $values 0]] 110 10 250 25 \
  33.         -c {Has closing tag} [lindex $values 1] 10 40 150 55 \
  34.         -t {Element type} 10 80 100 95 -r Normal [lindex $values 2] 10 100 100 115 \
  35.         -r {INPUT element with TYPE given above} [lindex $values 3] 10 120 300 135 \
  36.         -r {Plug-in} [lindex $values 4] 10 140 100 155 \
  37.         -t {Key binding} 10 180 90 195 -e [list [lindex $values 5]] 100 180 120 195 \
  38.         -c Shift [lindex $values 6] 10 210 60 225 \
  39.         -c Control [lindex $values 7] 80 210 150 225 \
  40.         -c Option [lindex $values 8] 160 210 220 225 \
  41.         -c Command [lindex $values 9] 230 210 320 225 \
  42.         -b OK 20 240 85 260 -b Cancel 105 240 170 260"
  43.         set values [eval [concat dialog -w 340 -h 270 $box]]
  44.         if {[lindex $values 11]} {return}
  45.         set element [string toupper [string trim [lindex $values 0]]]
  46.         set closingTag [lindex $values 1]
  47.         if {[lindex $values 2]} {
  48.             set elemType normal
  49.         } elseif {[lindex $values 3]} {
  50.             set elemType input
  51.         } else {
  52.             set elemType plugin
  53.         }
  54.         set elemKey [string toupper [string trim [lindex $values 5]]]
  55.         set keyStr ""
  56.         if {[lindex $values 6]} {append keyStr "<U"}
  57.         if {[lindex $values 7]} {append keyStr "<B"}
  58.         if {[lindex $values 8]} {append keyStr "<I"}
  59.         if {[lindex $values 9]} {append keyStr "<O"}
  60.         
  61.         # Check that input is ok.
  62.         if {![string length $element]} {
  63.             alertnote "You must specify the element."
  64.         } elseif {[info exists htmlElemAttrOptional1($element)]} {
  65.             alertnote "The element $element is already defined."
  66.             return
  67.         } elseif {![regexp {^[-_a-zA-Z0-9]+$} $element]} {
  68.             alertnote "Invalid characters in element name. For example, it may not contain spaces."
  69.         } elseif {[string length $elemKey] > 1} {
  70.             alertnote "You should only give one character for key binding."
  71.         } elseif {[string length $elemKey] && ($keyStr == "" || $keyStr == "<U")} {
  72.             alertnote "You must choose at least one of the modifiers control, option and command when you define a key binding."
  73.         } else {
  74.             set invalidInput 0
  75.         }
  76.     }
  77.     if {![string length $elemKey]} {
  78.         set keyStr ""
  79.     } else {
  80.         set elemKey "/$elemKey"
  81.     }    
  82.     
  83.     # Get the attributes    
  84.     set allattributes [htmlGetCustomAttrs $element {}]
  85.     if {![string length $allattributes]} {return}
  86.     set optional [lindex $allattributes 0]
  87.     set AttrRequired [lindex $allattributes 1]
  88.     set AttrNumber [lindex $allattributes 2]
  89.     set AttrChoices [lindex $allattributes 3]
  90.     set EventHandler [lindex $allattributes 4]
  91.     set URL [lindex $allattributes 5]
  92.     set Color [lindex $allattributes 6]
  93.     set Window [lindex $allattributes 7]
  94.     # Get the layout.
  95.     if {$elemType != "normal" || !$closingTag} {
  96.         set customproc [htmlSetCustProc1 {0 0} $elemType $element]
  97.     } else {
  98.         set customproc [htmlSetCustProc2 {1 0 0 0} $element]
  99.     }
  100.     if {![string length $customproc]} {return}
  101.     
  102.     # Save the element
  103.     message "Saving new element…"
  104.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  105.     if {![file exists $PREFS]} {mkdir $PREFS}
  106.     set fid [open $PREFS:HTMLadditions.tcl a+]
  107.     if {!$isfile} {puts $fid $htmlVersion}
  108.     puts $fid "$element \{set htmlElemKeyBinding($element) [list $keyStr$elemKey]\}"
  109.     set htmlElemKeyBinding($element) $keyStr$elemKey
  110.     puts $fid "$element \{set htmlElemProc($element) [list $customproc]\}"
  111.     set htmlElemProc($element) $customproc
  112.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler] {
  113.         if {[llength [set $rcne]]} {
  114.             puts $fid "$element \{set htmlElem${rcne}1($element) [list [set $rcne]]\}"
  115.             set htmlElem${rcne}1($element) [set $rcne]
  116.         }
  117.     }
  118.     # Remove possible old versions of htmlElemAttrUsed and htmlElemAttrMore
  119.     if {[info exists htmlElemAttrUsed($element)]} {
  120.         unset htmlElemAttrUsed($element)
  121.         removeArrDef htmlElemAttrUsed $element
  122.     }
  123.     if {[info exists htmlElemAttrMore($element)]} {
  124.         unset htmlElemAttrMore($element)
  125.         removeArrDef htmlElemAttrMore $element
  126.     }
  127.     
  128.     puts $fid "$element \{set htmlElemAttrOptional1($element) [list $optional]\}"
  129.     set htmlElemAttrOptional1($element) $optional
  130.     foreach ucw [list URL Color Window] {
  131.         if {[llength [set $ucw]]} {
  132.             foreach a [set $ucw] {
  133.                 puts $fid "$element \{lappend html${ucw}Attr $a\}"
  134.                 lappend html${ucw}Attr $a
  135.             }
  136.         }
  137.     }
  138.     if {$elemType == "plugin"} {
  139.         puts $fid "$element \{lappend htmlPlugins $element\}"
  140.         lappend htmlPlugins $element
  141.     }
  142.     foreach ucw [list URL Color Window] {
  143.         if {[llength [set spec$ucw]]} {
  144.             puts $fid "$element \{lappend htmlSpec$ucw [set spec$ucw]\}"
  145.             append htmlSpec$ucw " " [set spec$ucw]
  146.         }
  147.     }
  148.     close $fid
  149.     
  150.     message "Inserting new element in menu…"
  151.     set htmlAdditionExist 1
  152.     htmlBuildMenu
  153.     if {$HTMLmodeVars(JavaScriptColoring)} {
  154.         regModeKeywords -a -k $HTMLmodeVars(tagColor) \
  155.         HTML [concat "<$element" "/$element" $AttrRequired $optional]    
  156.     }
  157.     message "Done."
  158.     if {!$HTMLmodeVars(useBigWindows) && [llength $optional]} {htmlUseAttrs $element}
  159.     unset specURL
  160.     unset specColor
  161.     unset specWindow
  162. }
  163.  
  164. # Get attributes to custom element.
  165. proc htmlGetCustomAttrs {element allattrs {nomore 1}} {
  166.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  167.     global specURL specColor specWindow
  168.     
  169.     set allHTMLattrs [htmlGetAllAttrs]
  170.     set optional {}
  171.     set AttrRequired {}
  172.     set AttrChoices {}
  173.     set AttrNumber {}
  174.     set EventHandler {}
  175.     set URL {}
  176.     set Color {}
  177.     set Window {}
  178.     set specURL {}
  179.     set specColor {}
  180.     set specWindow {}
  181.     set i 0
  182.     set dispAttr $allattrs
  183.     
  184.     while {1} {
  185.         incr i
  186.         if {[catch {htmlCustomInpAttr $element $i $dispAttr $nomore} attribute]} {
  187.             if {$attribute != "Remove last!"} {return}
  188.             set toremove [lindex $dispAttr [expr [llength $dispAttr] - 1]]
  189.             set dispAttr [lreplace $dispAttr [expr [llength $dispAttr] - 1] [expr [llength $dispAttr] - 1]]
  190.             set allattrs [lreplace $allattrs [expr [llength $allattrs] - 1] [expr [llength $allattrs] - 1]]
  191.             set elemrm [lindex $toremove 0]
  192.             if {[lindex $toremove 1] == "(Flag)"} {
  193.                 if {[set ind [lsearch -exact $AttrRequired $elemrm]] >=0} {
  194.                     set AttrRequired [lreplace $AttrRequired $ind $ind]
  195.                 } elseif {[set ind [lsearch -exact $optional $elemrm]] >=0} {
  196.                     set optional [lreplace $optional $ind $ind]
  197.                 }
  198.             } else {
  199.                 foreach l [list optional AttrRequired AttrChoices AttrNumber EventHandler URL Color Window] {
  200.                     set tmp {}
  201.                     foreach m [set $l] {
  202.                         if {![string match "${elemrm}=*" $m]} {
  203.                             lappend tmp $m
  204.                         }
  205.                     }
  206.                     set $l $tmp
  207.                 }
  208.             }
  209.             foreach l [list URL Color Window] {
  210.                 if {[set where [lsearch -exact [set spec$l] "${element}=[string trimright $elemrm =]"]] >= 0 || \
  211.                 [set where [lsearch -exact [set spec$l] "${element}!=[string trimright $elemrm =]"]] >= 0} {
  212.                     set spec$l [lreplace [set spec$l] $where $where]
  213.                 }
  214.             }
  215.             incr i -2
  216.             continue
  217.         }
  218.         if {![string length $attribute]} {break}
  219.         if {[lsearch -exact [string toupper $allattrs] [string toupper [lindex $attribute 0]]] >= 0} {
  220.             alertnote "$element already has an attribute '[lindex $attribute 0]'."
  221.             incr i -1
  222.         } else {
  223.             if {[catch {htmlCustomAttrFix $element [lindex $attribute 0] \
  224.             [lindex $attribute 1] $allHTMLattrs} thisattr]} {
  225.                 incr i -1 
  226.                 continue
  227.             }
  228.             lappend allattrs [string trimright [lindex $thisattr 0] =]
  229.             set attr [lindex $thisattr 0]
  230.             set thistype [lindex $thisattr 1]
  231.             if {[lindex $attribute 2]} {
  232.                 lappend AttrRequired $attr
  233.             } elseif {$thistype != "Event handler"} {
  234.                 lappend optional $attr
  235.             } else {
  236.                 lappend EventHandler $attr
  237.             }
  238.             set attrext [expr ([lsearch -exact $allHTMLattrs $attr] >= 0 || [lsearch -exact $allHTMLattrs [string trimright $attr =]] >= 0)]
  239.             if {$thistype == "Choices"} {
  240.                 foreach c [lindex $thisattr 2] {
  241.                     lappend AttrChoices "$attr$c"
  242.                 }
  243.             } elseif {$thistype == "Number"} {
  244.                 lappend AttrNumber "$attr[lindex $thisattr 2]"
  245.             } elseif {$thistype == "URL" && [lsearch -exact $htmlURLAttr $attr] < 0 && !$attrext} {
  246.                 lappend URL $attr
  247.             } elseif {$thistype == "Color" && [lsearch -exact $htmlColorAttr $attr] < 0 && !$attrext} {
  248.                 lappend Color $attr
  249.             } elseif {$thistype == "Window" && [lsearch -exact $htmlWindowAttr $attr] < 0 && !$attrext} {
  250.                 lappend Window $attr
  251.             }
  252.             lappend dispAttr "[string trimright $attr =] (${thistype})"
  253.         }
  254.     }
  255.     return [list $optional $AttrRequired $AttrNumber $AttrChoices $EventHandler $URL $Color $Window]
  256. }
  257.  
  258. # Dialog for giving a new attribute.
  259. proc htmlCustomInpAttr {element num allattrs nomore} {
  260.     set typeList [list Other Number Choices Flag URL Color Window {Event handler}]
  261.     set values {0 0 {} Other 0}
  262.     set invalidInput 1
  263.     while {$invalidInput} {
  264.         set box "-t {Attribute $num for $element} 10 10 330 25 \
  265.         -e [list [lindex $values 2]] 10 40 150 55 \
  266.         -t Type: 170 40 205 55 \
  267.         -m [list [concat [list [lindex $values 3]] $typeList]] \
  268.         210 40 330 55 -c Required [lindex $values 4] 10 70 130 85"
  269.          if {$num > 1} {append box " -b {Remove last} 340 100 450 120"}
  270.          if {$nomore || $num > 1} {append box " -b {No more attributes} 340 70 480 90"}
  271.         set wi 10
  272.         set ht 120
  273.         if {[llength $allattrs]} {
  274.             append box " -t {All attributes} 10 100 200 115"
  275.             foreach ch $allattrs {
  276.                 append box " -t [list $ch] $wi $ht [expr $wi + 195] [expr $ht + 15]"
  277.                 incr wi 200
  278.                 if {$wi == 410} {
  279.                     set wi 10
  280.                     incr ht 20
  281.                 }
  282.             }
  283.         }
  284.         if {$wi == 210} {incr ht 20}
  285.         if {$ht < 130} {set ht 130}
  286.         set values [eval [concat dialog -w 490 -h $ht \
  287.         -b OK 340 10 405 30 -b Cancel 340 40 405 60 $box]]
  288.         if {[lindex $values 1]} {
  289.             error "Cancel"
  290.         } elseif {$num > 1 && [lindex $values 5]} {
  291.             error "Remove last!"
  292.         } elseif {[lindex $values 0]} {
  293.             set thisattr [string trim [lindex $values 2]]
  294.             set thistype [lindex $values 3]
  295.             if {$thistype != "Event handler"} {set thisattr [string toupper $thisattr]}
  296.             set required [lindex $values 4]
  297.             if {![regexp {^[-_a-zA-Z0-9]*$} $thisattr]} {
  298.                 alertnote "Invalid characters in attribute. For example, it may not contain spaces."
  299.             } elseif {[string length $thisattr]} {
  300.                 if {$required && $thistype == "Event handler"} {
  301.                     alertnote "Event handlers cannot be required attributes. It will be optional."
  302.                     set required 0
  303.                 }
  304.                 set invalidInput 0
  305.             }
  306.         } else {
  307.             return
  308.         }
  309.     }
  310.  
  311.     return [list $thisattr $thistype $required]
  312. }
  313.  
  314. # Dialogs to give more info about new attributes.
  315. proc htmlCustomAttrFix {element attr type allHTMLattrs {allchoices ""}} {
  316.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  317.     global specURL specColor specWindow
  318.  
  319.     # Check for special case with URL etc. if not called from htmlCustomNewChoice 
  320.     # (then allchoices has length >0)
  321.     foreach ucw [list URL Color Window] {
  322.         if {[lsearch -exact [set html${ucw}Attr] "$attr="] >= 0 && $type != $ucw && ![llength $allchoices]} {
  323.             lappend spec$ucw "$element!=$attr"
  324.         }
  325.     }
  326.     
  327.     switch $type {
  328.         Other {return [list "$attr=" $type]}
  329.         Number {
  330.             set values {0 0 0 {} 0}
  331.             while {1} {
  332.                 set box "-t {Range for $attr} 60 10 290 25 -t {Minvalue:} 10 40 100 55 \
  333.                 -e [list [lindex $values 2]] 110 40 130 55 -t {Maxvalue:} 150 40 240 55 \
  334.                 -e [list [lindex $values 3]] 250 40 270 55 -c {Value may be given in percent} \
  335.                 [lindex $values 4] 10 65 250 80"
  336.                 set values [eval [concat dialog -w 300 -h 120 \
  337.                 -b OK 20 90 85 110 -b Cancel 105 90 170 110 $box]]
  338.                 set min [string trim [lindex $values 2]]
  339.                 set max [string trim [lindex $values 3]]
  340.                 set percent [lindex $values 4]
  341.                 if {[lindex $values 1]} {
  342.                     error "Cancel"
  343.                 } elseif {[lindex $values 0]} {
  344.                     if {![htmlIsInteger $min]} {
  345.                         alertnote "A minimum value must be specified."
  346.                     } elseif {[string length $max] && ![htmlIsInteger $max]} {
  347.                         alertnote "Not a valid number for maximum value."
  348.                     } elseif {[string length $max] && $max < $min} {
  349.                         alertnote "Maxvalue is smaller than minvalue."
  350.                     } else {
  351.                         break
  352.                     }
  353.                 }
  354.             }
  355.             set number "$min:"
  356.             if {[string length $max]} {
  357.                 append number "$max:"
  358.             } else {
  359.                 append number "i:"
  360.             }
  361.             if {$percent} {
  362.                 append number "%"
  363.             } else {
  364.                 append number "n"
  365.             }
  366.             return [list "$attr=" $type $number]
  367.         }
  368.         Choices {
  369.             set i 0
  370.             set choices {}
  371.             while {1} {
  372.                 incr i
  373.                 set values {0 0 {}}
  374.                 set invalidInput 1
  375.                 while {$invalidInput} {
  376.                     set box "-t {Choice $i for $attr} 10 10 210 25 \
  377.                     -e [list [lindex $values 2]] 10 40 200 55"
  378.                     if {$i > 1} {append box " -b {No more choices} 220 70 340 90 -b {Remove last} 220 100 340 120"}
  379.                     set wi 10
  380.                     set ht 90
  381.                     if {[llength $allchoices]} {
  382.                         append box " -t {All choices} 10 70 200 85"
  383.                         foreach ch $allchoices {
  384.                             append box " -t $ch $wi $ht [expr $wi + 95] [expr $ht + 15]"
  385.                             incr wi 100
  386.                             if {$wi == 210} {
  387.                                 set wi 10
  388.                                 incr ht 20
  389.                             }
  390.                         }
  391.                     }
  392.                     if {$wi == 110} {incr ht 20}
  393.                     if {$ht < 130} {set ht 130}
  394.                     set values [eval [concat dialog -w 350 -h $ht \
  395.                     -b OK 220 10 285 30 -b Cancel 220 40 285 60 \
  396.                     $box]]
  397.                     if {[lindex $values 1]} {
  398.                         error "Cancel"
  399.                     } elseif {$i > 1 && [lindex $values 3] } {
  400.                         return [list "$attr=" $type $choices]
  401.                     } elseif {$i > 1 && [lindex $values 4]} {
  402.                         incr i -1
  403.                         set choices [lreplace $choices [expr [llength $choices] - 1] [expr [llength $choices] - 1]]
  404.                         set allchoices [lreplace $allchoices [expr [llength $allchoices] - 1] [expr [llength $allchoices] - 1]]
  405.                     } elseif {[lindex $values 0]} {
  406.                         set thischoice [string toupper [string trim [lindex $values 2]]]
  407.                         if {![regexp {^[-_a-zA-Z0-9]*$} $thischoice]} {
  408.                             alertnote "Invalid characters in choice.  For example, it may not contain spaces."
  409.                         } elseif {[string length $thischoice]} {
  410.                             if {[lsearch -exact $allchoices $thischoice] >=0 } {
  411.                                 alertnote "$attr already has a choice '$thischoice'."
  412.                             } else {
  413.                                 set invalidInput 0
  414.                             }
  415.                         }
  416.                     }
  417.                 }
  418.                 lappend choices $thischoice
  419.                 lappend allchoices $thischoice
  420.             }
  421.         }
  422.         Flag {return [list $attr $type]}
  423.         URL {
  424.             if {[lsearch -exact $htmlURLAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  425.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  426.                 lappend specURL "${element}=$attr"
  427.             }
  428.             return [list "$attr=" $type]
  429.         }
  430.         Color {
  431.             if {[lsearch -exact $htmlColorAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  432.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  433.                 lappend specColor "${element}=$attr"
  434.             }
  435.             return [list "$attr=" $type]
  436.         }
  437.         Window {
  438.             if {[lsearch -exact $htmlWindowAttr "$attr="] < 0 && ([lsearch -exact $allHTMLattrs "$attr="] >= 0
  439.             || [lsearch -exact $allHTMLattrs $attr] >= 0)} {
  440.                 lappend specWindow "${element}=$attr"
  441.             }
  442.             return [list "$attr=" $type]
  443.         }
  444.         "Event handler" {
  445.             return [list "$attr=" $type]
  446.         }
  447.     }
  448.     
  449. }
  450.  
  451. proc htmlSetCustProc1 {values elemType element} {
  452.     set box "-t {Layout} 80 10 180 25 \
  453.     -c {Always a new line before tag.} [lindex $values 0] 10 40 225 55 \
  454.     -c {Always a new line after tag.} [lindex $values 1] 10 60 225 75 \
  455.     -b OK 20 90 85 110 -b Cancel 105 90 170 110"
  456.     set values [eval [concat dialog -w 230 -h 120 $box]]
  457.     if {[lindex $values 3]} {return}
  458.     switch $elemType {
  459.         normal {set  customproc "htmlBuildOpening $element"}
  460.         input {set customproc "htmlBuildInputElem $element"}
  461.         plugin {set customproc "htmlBuildOpening EMBED"}
  462.     }
  463.     lappend customproc [lindex $values 0] [lindex $values 1]
  464.     if {$elemType == "plugin"} {lappend customproc $element}
  465.     return $customproc
  466. }
  467.  
  468. proc htmlSetCustProc2 {values element} {
  469.     set box "-t {Layout} 80 10 180 25 \
  470.     -r {text<TAG>text</TAG>text} [lindex $values 0] 10 40 200 60 \
  471.     -r {text\r<TAG>text</TAG>\rtext} [lindex $values 1] 10 70 150 130 \
  472.     -r {blank line\r<TAG>text</TAG>\rblank line} [lindex $values 2] 10 140 150 200 \
  473.     -r {blank line\r<TAG>\rtext\r</TAG>\rblank line} [lindex $values 3] 10 210 150 310"
  474.     set values [eval [concat dialog -w 200 -h 350 \
  475.     -b OK 20 320 85 340 -b Cancel 105 320 170 340 $box]]
  476.     if {[lindex $values 1]} {return}
  477.     if {[lindex $values 2]} {set customproc "htmlBuildElem $element"}
  478.     if {[lindex $values 3]} {set customproc "htmlBuildCRElem $element"}
  479.     if {[lindex $values 4]} {set customproc "htmlBuildCRElem $element 1"}
  480.     if {[lindex $values 5]} {set customproc "htmlBuildCR2Elem $element"}
  481.     return $customproc
  482. }
  483.  
  484. # Add new attributes to an element.
  485. proc htmlCustomNewAttr {} {
  486.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemKeyBinding
  487.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  488.     global htmlElemEventHandler1 HTMLmodeVars htmlSpecURL htmlSpecColor htmlSpecWindow
  489.     global specURL specColor specWindow htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  490.     
  491.     if {$htmlPackageToUse != 1} {return}
  492.     if {[info exists htmlShownWarning]} {htmlDisabled}
  493.     
  494.     if {[catch {listpick -p "Select element to add attributes to." \
  495.     [lsort [array names htmlElemAttrOptional1]]} element] || \
  496.     ![string length $element]} {return}
  497.     set allattrs {}
  498.     foreach e [htmlGetRequired $element] {
  499.         lappend allattrs [string trimright $e =]
  500.     }
  501.     foreach e [htmlGetOptional $element] {
  502.         lappend allattrs [string trimright $e =]
  503.     } 
  504.     if {[info exists htmlElemEventHandler1($element)]} {
  505.         foreach e $htmlElemEventHandler1($element) {
  506.             lappend allattrs [string trimright $e =]
  507.         }
  508.     }
  509.     set attributes [htmlGetCustomAttrs $element $allattrs 0]
  510.     if {![string length [join $attributes ""]]} {return}
  511.     set AttrOptional [lindex $attributes 0]
  512.     set AttrRequired [lindex $attributes 1]
  513.     set AttrNumber [lindex $attributes 2]
  514.     set AttrChoices [lindex $attributes 3]
  515.     set EventHandler [lindex $attributes 4]
  516.     set URL [lindex $attributes 5]
  517.     set Color [lindex $attributes 6]
  518.     set Window [lindex $attributes 7]
  519.     
  520.     if {[regexp { } $element]} {
  521.         set arg "\[list $element\]"
  522.     } else {
  523.         set arg $element
  524.     }
  525.     
  526.     if {![llength [htmlGetOptional $element]]} {
  527.         set rmenu 1
  528.     } else {
  529.         set rmenu 0
  530.     }
  531.     # Save the element
  532.     message "Saving new attributes…"
  533.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  534.     if {![file exists $PREFS]} {mkdir $PREFS}
  535.     set fid [open $PREFS:HTMLadditions.tcl a+]
  536.     if {!$isfile} {puts $fid $htmlVersion}
  537.     foreach rcne [list AttrRequired AttrChoices AttrNumber EventHandler AttrOptional] {
  538.         if {[string length [set $rcne]]} {
  539.             puts $fid "[list $element] \{lappend htmlElem${rcne}1($arg) [set $rcne]\}"
  540.             append htmlElem${rcne}1($element) " " [set $rcne]
  541.         }
  542.     }
  543.     foreach ucw [list URL Color Window] {
  544.         if {[string length [set $ucw]]} {
  545.             foreach a [set $ucw] {
  546.                 puts $fid "[list $element] \{lappend html${ucw}Attr $a\}"
  547.                 lappend html${ucw}Attr $a
  548.             }
  549.         }
  550.     }
  551.     foreach ucw [list URL Color Window] {
  552.         if {[llength [set spec$ucw]]} {
  553.             puts $fid "[list $element] \{lappend htmlSpec$ucw [set spec$ucw]\}"
  554.             append htmlSpec$ucw " " [set spec$ucw]
  555.         }
  556.     }
  557.     close $fid
  558.     set htmlAdditionExist 1
  559.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  560.     if {$rmenu} {htmlBuildMenu}
  561.     if {$HTMLmodeVars(JavaScriptColoring)} {
  562.         regModeKeywords -a -k $HTMLmodeVars(tagColor) \
  563.         HTML [concat $AttrRequired $AttrOptional]    
  564.     }
  565.     unset specURL
  566.     unset specColor
  567.     unset specWindow
  568.     message "Done."
  569.     if {!$HTMLmodeVars(useBigWindows) && [llength [htmlGetOptional $element]]} {htmlUseAttrs $element}
  570. }
  571.  
  572. # Add new choices to an attribute with predefined choices.
  573. proc htmlCustomNewChoice {} {
  574.     global htmlElemAttrChoices1 PREFS htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  575.     global htmlElemKeyBinding
  576.     
  577.     if {$htmlPackageToUse != 1} {return}
  578.     if {[info exists htmlShownWarning]} {htmlDisabled}
  579.  
  580.     if {[catch {listpick -p "Select element to add choices to." \
  581.     [lsort [array names htmlElemAttrChoices1]]} element] || \
  582.     ![string length $element]} {return}
  583.     set choiceatts ""
  584.     foreach e $htmlElemAttrChoices1($element) {
  585.         regexp {[^=]*} $e attr
  586.         if {[lsearch $choiceatts $attr] < 0} {lappend choiceatts $attr}
  587.     }
  588.     if {[catch {listpick -p "Select attribute to add choices to." [lsort $choiceatts]} attr] || \
  589.     ![string length $attr]} {return}
  590.     foreach c $htmlElemAttrChoices1($element) {
  591.         if {[string match "${attr}=*" $c]} {
  592.             lappend allchoices [string range $c [expr [string length $attr] + 1] end]
  593.         }    
  594.     }
  595.     
  596.     set newchoices [htmlCustomAttrFix $element $attr Choices [htmlGetAllAttrs] $allchoices]
  597.     foreach c [lindex $newchoices 2] {
  598.         lappend choices "${attr}=$c"
  599.     }
  600.     
  601.     if {[regexp { } $element]} {
  602.         set arg "\[list $element\]"
  603.     } else {
  604.         set arg $element
  605.     }
  606.     # Save the choices
  607.     set isfile [file exists $PREFS:HTMLadditions.tcl]
  608.     if {![file exists $PREFS]} {mkdir $PREFS}
  609.     set fid [open $PREFS:HTMLadditions.tcl a+]
  610.     if {!$isfile} {puts $fid $htmlVersion}
  611.     puts $fid "[list $element] \{lappend htmlElemAttrChoices1($arg) $choices\}"
  612.     append htmlElemAttrChoices1($element) " " $choices
  613.     close $fid
  614.     set htmlAdditionExist 1
  615.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist    
  616.     message "New choices saved."
  617. }
  618.  
  619. #
  620. # Change key binding for a custom element.
  621. #
  622. proc htmlCustomChangeKey {} {
  623.     global htmlElemKeyBinding PREFS htmlShownWarning htmlPackageToUse
  624.     
  625.     if {$htmlPackageToUse != 1} {return}
  626.     if {[info exists htmlShownWarning]} {htmlDisabled}
  627.  
  628.     if {![info exists htmlElemKeyBinding]} {
  629.         alertnote "No custom elements are defined."
  630.         return
  631.     }
  632.     if {[catch {listpick -p "Select element to change key binding for." \
  633.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  634.     set keystr $htmlElemKeyBinding($elem)
  635.     if {[string length $keystr]} {
  636.         set values "0 0 [string range $keystr [expr [string length $keystr] - 1] end]"
  637.         set keystr [string range $keystr 0 [expr [string length $keystr] - 3]]
  638.         lappend values [regexp {U} $keystr]
  639.         lappend values [regexp {B} $keystr]
  640.         lappend values [regexp {I} $keystr]
  641.         lappend values [regexp {O} $keystr]
  642.     } else {
  643.         set values {0 0 {} 0 0 0 0}
  644.     }
  645.     while {1} {
  646.         set box "-t {Key binding for $elem} 40 10 290 25 \
  647.         -t Key 10 40 40 55 -e [list [lindex $values 2]] 50 40 70 55 \
  648.         -c Shift [lindex $values 3] 10 60 60 75 \
  649.         -c Control [lindex $values 4] 80 60 150 75 \
  650.         -c Option [lindex $values 5] 160 60 220 75 \
  651.         -c Command [lindex $values 6] 230 60 315 75"
  652.         set values [eval [concat dialog -w 320 -h 120 \
  653.         -b OK 20 90 85 110 -b Cancel 105 90 170 110 $box]]
  654.         if {[lindex $values 1]} {return}
  655.         set elemKey [string toupper [string trim [lindex $values 2]]]
  656.         set keyStr ""
  657.         if {[lindex $values 3]} {append keyStr "<U"}
  658.         if {[lindex $values 4]} {append keyStr "<B"}
  659.         if {[lindex $values 5]} {append keyStr "<I"}
  660.         if {[lindex $values 6]} {append keyStr "<O"}
  661.         if {[string length $elemKey] > 1} {
  662.             alertnote "You should only give one character for key binding."
  663.         } elseif {[string length $elemKey] && ($keyStr == "" || $keyStr == "<U")} {
  664.             alertnote "You must choose at least one of the modifiers control, option and command when you define a key binding."
  665.         } else {
  666.             break
  667.         }
  668.     }
  669.     if {![string length $elemKey]} {
  670.         set keyStr ""
  671.     } else {
  672.         set elemKey "/$elemKey"
  673.     }    
  674.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  675.         alertnote "Cannot find 'HTMLadditions.tcl'. Key binding cannot be changed."
  676.         return
  677.     }
  678.     message "Redefining key binding…"
  679.     set fid [open $PREFS:HTMLadditions.tcl r]
  680.     set filecont [string trimright [read $fid] "\n"]
  681.     close $fid
  682.     foreach line [split $filecont "\n"] {
  683.         if {[lindex $line 0] == $elem && [regexp {htmlElemKeyBinding} $line]} {
  684.             append newlines "$elem \{set htmlElemKeyBinding($elem) [list $keyStr$elemKey]\}\n"
  685.         } else {
  686.             append newlines "$line\n"
  687.         }
  688.     }
  689.     set fid [open $PREFS:HTMLadditions.tcl w]
  690.     puts -nonewline $fid $newlines
  691.     close $fid
  692.     set htmlElemKeyBinding($elem) $keyStr$elemKey
  693.     htmlBuildMenu
  694.     message "Done."
  695. }
  696.  
  697. #
  698. # Change type and layout for a custom element.
  699. #
  700. proc htmlCustomChangeType {} {
  701.     global htmlElemKeyBinding htmlElemProc PREFS htmlPlugins htmlShownWarning htmlPackageToUse
  702.     
  703.     if {$htmlPackageToUse != 1} {return}
  704.     if {[info exists htmlShownWarning]} {htmlDisabled}
  705.  
  706.     if {![info exists htmlElemKeyBinding]} {
  707.         alertnote "No custom elements are defined."
  708.         return
  709.     }
  710.     if {[catch {listpick -p "Select element to change type and layout for." \
  711.     [lsort [array names htmlElemKeyBinding]]} elem] || ![string length $elem]} {return}
  712.     set eproc $htmlElemProc($elem)
  713.     set proctype [lindex $eproc 0]
  714.     if {$proctype == "htmlBuildOpening" || $proctype == "htmlBuildInputElem"} {
  715.         if {[lindex $eproc 1] == "EMBED"} {
  716.             set type plugin
  717.         } else {
  718.             set type normal
  719.         }
  720.         if {$proctype == "htmlBuildInputElem"} {set type input}
  721.         set closing 0
  722.         set values "[lindex $eproc 2] [lindex $eproc 3]"
  723.     } else {
  724.         set type normal
  725.         set closing 1
  726.         if {$proctype == "htmlBuildElem"} {set values {1 0 0 0}}
  727.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 2} {set values {0 1 0 0}}
  728.         if {$proctype == "htmlBuildCRElem" && [llength $eproc] == 3} {set values {0 0 1 0}}
  729.         if {$proctype == "htmlBuildCR2Elem"} {set values {0 0 0 1}}
  730.     }
  731.     set box "-t $elem 100 10 300 25 \
  732.     -c {Has closing tag} $closing 10 40 150 55 \
  733.     -t {Element type} 10 80 100 95 -r Normal [regexp {normal} $type] 10 100 100 115 \
  734.     -r {INPUT element with TYPE given above} [regexp {input} $type] 10 120 300 135 \
  735.     -r {Plug-in} [regexp {plugin} $type] 10 140 100 155 \
  736.     -b OK 20 170 85 190 -b Cancel 105 170 170 190"
  737.     set typeval [eval [concat dialog -w 310 -h 200 $box]]
  738.     if {[lindex $typeval 5]} {return}
  739.     set newclosing [lindex $typeval 0]
  740.     if {[lindex $typeval 1]} {set newtype normal}
  741.     if {[lindex $typeval 2]} {set newtype input; set newclosing 0}
  742.     if {[lindex $typeval 3]} {set newtype plugin; set newclosing 0}
  743.  
  744.     if {$newclosing} {
  745.         if {$newclosing != $closing} {set values {1 0 0 0}}
  746.         set customproc [htmlSetCustProc2 $values $elem]
  747.     } else {
  748.         if {$newclosing != $closing} {set values {0 0}}
  749.         set customproc [htmlSetCustProc1 $values $newtype $elem]
  750.     }
  751.     if {![string length $customproc]} {return}
  752.     
  753.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  754.         alertnote "Cannot find 'HTMLadditions.tcl'. Type and layout cannot be changed."
  755.         return
  756.     }
  757.     message "Redefining type and layout…"
  758.     set fid [open $PREFS:HTMLadditions.tcl r]
  759.     set filecont [string trimright [read $fid] "\n"]
  760.     close $fid
  761.     foreach line [split $filecont "\n"] {
  762.         if {[lindex $line 0] == $elem && [regexp {htmlElemProc} $line]} {
  763.             append newlines "$elem \{set htmlElemProc($elem) [list $customproc]\}\n"
  764.         } elseif {$type == "plugin" && $newtype != "plugin" && [lindex $line 0] == $elem && \
  765.         [regexp {htmlPlugins} $line]} {
  766.             set where [lsearch -exact $htmlPlugins $elem]
  767.             set htmlPlugins [lreplace $htmlPlugins $where $where]
  768.         } else {
  769.             append newlines "$line\n"
  770.         }
  771.     }
  772.     if {$newtype == "plugin" && $type != "plugin"} {
  773.         lappend htmlPlugins $elem
  774.         append newlines "$elem \{lappend htmlPlugins $elem\}\n"
  775.     }
  776.     set fid [open $PREFS:HTMLadditions.tcl w]
  777.     puts -nonewline $fid $newlines
  778.     close $fid
  779.     set htmlElemProc($elem) $customproc
  780.     message "Done."
  781. }
  782.  
  783. # Remove custom element ot additions to an element.
  784. proc htmlCustomRemove {} {
  785.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr
  786.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  787.     global htmlElemEventHandler1 htmlElemProc htmlElemKeyBinding htmlPlugins
  788.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion htmlShownWarning htmlAdditionExist htmlPackageToUse
  789.     
  790.     if {$htmlPackageToUse != 1} {return}
  791.     
  792.     if {[info exists htmlShownWarning]} {htmlDisabled}
  793.     
  794.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  795.         if {[info exists htmlElemKeyBinding]} {
  796.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  797.         } else {
  798.             alertnote "No custom additions has been made."
  799.         }
  800.         return
  801.     }
  802.     set fid [open $PREFS:HTMLadditions.tcl r]
  803.     set additions [string trimright [read $fid] "\n"]
  804.     close $fid
  805.     set elems ""
  806.     foreach line [lrange [split $additions "\n"] 1 end] {
  807.         set element [lindex $line 0]
  808.         if {[lsearch -exact $elems $element] < 0} {lappend elems $element}
  809.     }
  810.     if {[catch {listpick -p "Select element to remove additions from." [lsort $elems]} element] || \
  811.     ![string length $element] || [askyesno "Remove additions from $element?"] == "no"} {return}
  812.     
  813.     # Perhaps rebuild menu for if old elem and no optional attrs after removal.  
  814.     if {[llength [htmlGetOptional $element]]} {
  815.         set rmenu 1
  816.     } else {
  817.         set rmenu 0
  818.     }
  819.  
  820.     message "Removing additions to $element…"
  821.     set isNewElem [info exists htmlElemKeyBinding($element)]
  822.     # If new element, unset all its variables.
  823.     if {$isNewElem} {
  824.         catch {unset htmlElemAttrRequired1($element)}
  825.         catch {unset htmlElemAttrChoices1($element)}
  826.         catch {unset htmlElemAttrNumber1($element)}
  827.         catch {unset htmlElemAttrOptional1($element)}
  828.         catch {unset htmlElemEventHandler1($element)}
  829.         set tmpkey $htmlElemKeyBinding($element)
  830.         catch {unset htmlElemKeyBinding($element)}
  831.         catch {unset htmlElemProc($element)}
  832.         set isPlugin [lsearch -exact $htmlPlugins $element]
  833.         if {$isPlugin >=0 } {set htmlPlugins [lreplace $htmlPlugins $isPlugin $isPlugin]}
  834.         if {![llength [array names htmlElemKeyBinding]]} {
  835.             catch {unset htmlElemKeyBinding}
  836.             if {[string length $tmpkey]} {
  837.                 set key [string tolower [string range $tmpkey [expr [string length $tmpkey] - 1] end]]
  838.                 set mods ""
  839.                 foreach m [split [string range $tmpkey 1 [expr [string length $tmpkey] - 3]] < ] {
  840.                     if {$m == "B"} {append mods z}
  841.                     if {$m == "I"} {append mods o}
  842.                     if {$m == "U"} {append mods s}
  843.                     if {$m == "O"} {append mods c}
  844.                 }
  845.                 catch {unbind '$key' <$mods> {} HTML}
  846.             }
  847.         }
  848.         if {![llength [array names htmlElemProc]]} {catch {unset htmlElemProc}}
  849.     }
  850.     set newlines ""
  851.     foreach line [lrange [split $additions "\n"] 1 end] {
  852.         set command [lindex $line 1]
  853.         if {[lindex $line 0] != $element} {
  854.             append newlines "$line\n"
  855.         } elseif {[lindex $command 0] == "lappend"} {
  856.             set var [lindex $command 1]
  857.             # Remove from URL, Color and Window lists.
  858.             foreach ucw [list URL Color Window] {
  859.                 if {$var == "html${ucw}Attr"} {
  860.                     lappend ${ucw}maybe [lindex $command 2]
  861.                     set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  862.                     set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  863.                 }
  864.                 if {$var == "htmlSpec${ucw}"} {
  865.                     foreach c [lrange $command 2 end] {
  866.                         set where [lsearch -exact [set htmlSpec${ucw}] $c]
  867.                         set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  868.                     }
  869.                 }
  870.             } 
  871.             # If added attribute to old element, remove attribute
  872.             if {!$isNewElem && $var != "htmlURLAttr" && $var != "htmlColorAttr" && \
  873.             $var != "htmlWindowAttr" && $var != "htmlSpecURL" && $var != "htmlSpecColor" && \
  874.             $var != "htmlSpecWindow"} {
  875.                 regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  876.                 foreach c $added {
  877.                     set where [lsearch -exact [set ${var}($element)] $c]
  878.                     set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  879.                 }
  880.             }
  881.         }
  882.     }
  883.     # Unset empty lists for old variables.
  884.     if {!$isNewElem} {
  885.         foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  886.             if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  887.                 unset html${c}1($element)
  888.             }
  889.         }
  890.     }
  891.     # URL, Color or Window attributes just removed
  892.     # should be replaced if they are used by some other element.
  893.     foreach ucw [list URL Color Window] {
  894.         if {[info exists ${ucw}maybe]} {
  895.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  896.         }
  897.     }
  898.     if {[string length $newlines]} {
  899.         set fid [open $PREFS:HTMLadditions.tcl w]
  900.         puts -nonewline $fid "$htmlVersion\n$newlines"
  901.         close $fid
  902.     } else {
  903.         removeFile $PREFS:HTMLadditions.tcl
  904.         set htmlAdditionExist 0
  905.     }
  906.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist
  907.     if {$isNewElem || ($rmenu && ![llength [htmlGetOptional $element]])} {htmlBuildMenu}
  908.     message "Done."
  909. }
  910.  
  911. proc htmlUCWmaybe {ucw maybe} {
  912.     global htmlElemAttrRequired1 htmlElemAttrOptional1 htmlSpecURL htmlSpecColor htmlSpecWindow
  913.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  914.     
  915.     set newlines ""
  916.     foreach m $maybe {
  917.         set foundit 0
  918.         foreach e [array names htmlElemAttrRequired1] {
  919.             if {[lsearch -exact $htmlElemAttrRequired1($e) $m] >= 0 && \
  920.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  921.                 append newlines "[list $e] \{lappend html${ucw}Attr $m\}\n"
  922.                 lappend html${ucw}Attr $m
  923.                 set foundit 1
  924.                 break
  925.             } 
  926.         }
  927.         if {$foundit} {continue}
  928.         foreach e [array names htmlElemAttrOptional1] {
  929.             if {[lsearch -exact $htmlElemAttrOptional1($e) $m] >= 0 && \
  930.             [lsearch -exact [set htmlSpec$ucw] "$e!=[string trimright $m =]"] < 0} {
  931.                 append newlines "[list $e] \{lappend html${ucw}Attr $m\}\n"
  932.                 lappend html${ucw}Attr $m
  933.                 break
  934.             } 
  935.         }
  936.     }
  937.     return $newlines
  938. }
  939.  
  940. # Remove custom element ot additions to an element.
  941. proc htmlCustomRemoveAttrs {} {
  942.     global htmlElemAttrOptional1 htmlURLAttr htmlColorAttr htmlWindowAttr htmlElemKeyBinding
  943.     global PREFS htmlElemAttrRequired1 htmlElemAttrChoices1 htmlElemAttrNumber1
  944.     global htmlElemEventHandler1 htmlAdditionExist
  945.     global htmlSpecURL htmlSpecColor htmlSpecWindow htmlVersion htmlShownWarning htmlPackageToUse
  946.     
  947.     if {$htmlPackageToUse != 1} {return}
  948.     if {[info exists htmlShownWarning]} {htmlDisabled}
  949.     
  950.     if {![file exists $PREFS:HTMLadditions.tcl]} {
  951.         if {[info exists htmlElemKeyBinding]} {
  952.             alertnote "Cannot find 'HTMLadditions.tcl'. Custom additions cannot be removed."
  953.         } else {
  954.             alertnote "No custom additions has been made."
  955.         }
  956.         return
  957.     }
  958.     set fid [open $PREFS:HTMLadditions.tcl r]
  959.     set additions [string trimright [read $fid] "\n"]
  960.     close $fid
  961.     set elems ""
  962.     foreach line [lrange [split $additions "\n"] 1 end] {
  963.         set element [lindex $line 0]
  964.         if {[lsearch -exact $elems $element] < 0 && \
  965.         ([llength [concat [htmlGetRequired $element] [htmlGetOptional $element]]] || \
  966.         [info exists htmlElemEventHandler1($element)])} {
  967.             lappend elems $element
  968.         }
  969.     }
  970.     if {[catch {listpick -p "Select element to remove attributes from." [lsort $elems]} element] || \
  971.     ![string length $element]} {return}
  972.     
  973.     set allatts {}
  974.     foreach line [lrange [split $additions "\n"] 1 end] {
  975.         set command [lindex $line 1]
  976.         if {[lindex $line 0] == $element} {
  977.             regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  978.             set added [string trimleft [string trimright $added \}] \{]
  979.             if {$var == "htmlElemAttrRequired1" || $var == "htmlElemAttrOptional1" || $var == "htmlElemEventHandler1"} {
  980.                 foreach c $added {
  981.                     if {[lsearch -exact $allatts [string trimright $c =]] < 0} {
  982.                         lappend allatts [string trimright $c =]
  983.                     }
  984.                 }
  985.             } elseif {$var == "htmlElemAttrChoices1"} {
  986.                 foreach c $added {
  987.                     regexp {[^=]+} $c tmp
  988.                     if {[lsearch -exact $allatts $tmp] < 0} {
  989.                         lappend allatts $tmp
  990.                     }
  991.                 }
  992.             }
  993.         }
  994.     }
  995.     
  996.     if {[catch {listpick -p "Select attributes to remove." -l [lsort $allatts]} attrs] || \
  997.     ![string length $attrs]} {return}
  998.             
  999.     # Perhaps rebuild menu for if old elem and no optional attrs after removal.  
  1000.     if {[llength [htmlGetOptional $element]]} {
  1001.         set rmenu 1
  1002.     } else {
  1003.         set rmenu 0
  1004.     }
  1005.  
  1006.     message "Removing attributes from $element…"
  1007.     set newlines ""
  1008.     foreach line [lrange [split $additions "\n"] 1 end] {
  1009.         set command [lindex $line 1]
  1010.         if {[lindex $line 0] != $element} {
  1011.             append newlines "$line\n"
  1012.         } else {
  1013.             set var [lindex $command 1]
  1014.             # Remove from URL, Color and Window lists.
  1015.             foreach ucw [list URL Color Window] {
  1016.                 if {$var == "html${ucw}Attr"} {
  1017.                     if {[lsearch -exact $attrs [string trimright [lindex $command 2] =]] >= 0} {
  1018.                         lappend ${ucw}maybe [lindex $command 2]
  1019.                         set where [lsearch -exact [set html${ucw}Attr] [lindex $command 2]]
  1020.                         set html${ucw}Attr [lreplace [set html${ucw}Attr] $where $where]
  1021.                     } else {
  1022.                         append newlines "$line\n"
  1023.                     }
  1024.                 }
  1025.                 if {$var == "htmlSpec${ucw}"} {
  1026.                     set tmpadd [lrange $command 2 end]
  1027.                     foreach c $tmpadd {
  1028.                         regexp {[^!=]+!?=(.*)} $c dum tmp
  1029.                         if {[lsearch -exact $attrs $tmp] >= 0} {
  1030.                             set where [lsearch -exact [set htmlSpec${ucw}] $c]
  1031.                             set htmlSpec${ucw} [lreplace [set htmlSpec${ucw}] $where $where]
  1032.                             set where [lsearch -exact $tmpadd $c]
  1033.                             set tmpadd [lreplace $tmpadd $where $where]
  1034.                         }
  1035.                     }
  1036.                     if {[llength $tmpadd]} {append newlines "[list $element] \{lappend htmlSpec${ucw} $tmpadd\}\n"} 
  1037.                 }
  1038.             } 
  1039.             if {[lsearch {htmlURLAttr htmlColorAttr htmlWindowAttr htmlSpecURL htmlSpecColor htmlSpecWindow htmlPlugins} $var] < 0 && \
  1040.             ![string match "htmlElemKeyBinding*" $var] && ![string match "htmlElemProc*" $var]} {
  1041.                 regexp {([^\(]+)\(([^\)]+)\)[ ]+(.+)} [lrange $command 1 end] dummy var arg added
  1042.                 set added [string trimleft [string trimright $added \}] \{]
  1043.                 foreach c $added {
  1044.                     regexp {[^=]+} $c tmp
  1045.                     if {[lsearch -exact $attrs $tmp] >= 0} {
  1046.                         set where [lsearch -exact [set ${var}($element)] $c]
  1047.                         set ${var}($element) [lreplace [set ${var}($element)] $where $where]
  1048.                         set where [lsearch -exact $added $c]
  1049.                         set added [lreplace $added $where $where]
  1050.                     }
  1051.                 }
  1052.                 if {[llength $added] || ([lindex $command 0] == "set" && $var == "htmlElemAttrOptional1")} {
  1053.                     if {[lindex $command 0] == "set"} {set added [list $added]}
  1054.                     append newlines "[list $element] \{[lindex $command 0] ${var}($arg) $added\}\n"
  1055.                 }
  1056.             }
  1057.             if {[string match "htmlElemKeyBinding*" $var] || [string match "htmlElemProc*" $var]} {
  1058.                 append newlines "$line\n"
  1059.             }
  1060.         }
  1061.     }
  1062.     # Unset empty lists.
  1063.     foreach c [list AttrRequired AttrChoices AttrNumber EventHandler] {
  1064.         if {[info exists html${c}1($element)] && ![llength html${c}1($element)]} {
  1065.             unset html${c}1($element)
  1066.         }
  1067.     }
  1068.     # URL, Color or Window attributes just removed
  1069.     # should be replaced if they are used by some other element.
  1070.     foreach ucw [list URL Color Window] {
  1071.         if {[info exists ${ucw}maybe]} {
  1072.             append newlines [htmlUCWmaybe $ucw [set ${ucw}maybe]]
  1073.         }
  1074.     }
  1075.     if {[string length $newlines]} {
  1076.         set fid [open $PREFS:HTMLadditions.tcl w]
  1077.         puts -nonewline $fid "$htmlVersion\n$newlines"
  1078.         close $fid
  1079.     } else {
  1080.         removeFile $PREFS:HTMLadditions.tcl
  1081.         set htmlAdditionExist 0
  1082.     }
  1083.     htmlEnableExtend [info exists htmlElemKeyBinding] $htmlAdditionExist
  1084.     if {$rmenu && ![llength [htmlGetOptional $element]]} {htmlBuildMenu}
  1085.     message "Done."
  1086. }
  1087.  
  1088.